home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Tools / Turbo Pascal V7 / TVFM.ZIP / EDITPAL.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-03  |  19KB  |  703 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision File Manager Demo               }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. {$X+}
  9. {$V-}
  10.  
  11. uses Drivers, Objects, App, Views, Dialogs, Menus, StdDlg, MsgBox,
  12.      HistList, ColorSel;
  13.  
  14. const
  15.  
  16.   AddToWin =
  17.     #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79 +
  18.     #80#81#82#83#84#85#86#87#88#89#90#91#92#93#94#95 +
  19.     #96#97#98#99#100#101#102#103#104#105#106#107#108#109#110#111 +
  20.     #112#113#114#115#116#117#118#119#120#121#122#123#124#125#126#127;
  21.  
  22.   AppPal : String[Length(CColor) * 2] =
  23.     CColor + CColor;
  24.  
  25.   WinPal : String[Length(CDialog) + 64] =
  26.     CDialog + AddToWin;
  27.  
  28.   GrpPal : String[64] =
  29.     #33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48 +
  30.     #49#50#51#52#53#54#55#56#57#58#59#60#61#62#63#64 +
  31.     #65#66#67#68#69#70#71#72#73#74#75#76#77#78#79#80 +
  32.     #81#82#83#84#85#86#87#88#89#90#91#92#93#94#95#96;
  33.  
  34.   cmNothing = 100;
  35.   cmInActive = 101;
  36.  
  37.   { Change the current palette entry }
  38.   cmBack = 110;
  39.   cmFore = 111;
  40.  
  41.   { Commands to insert new windows and controls }
  42.  
  43.   cmBWindow     = 200;
  44.   cmCWindow     = 201;
  45.   cmGWindow     = 202;
  46.   cmDListBox    = 204;  { Dialog with TListBox }
  47.   cmDClusters   = 205;
  48.   cmDInputs     = 206;
  49.  
  50.   cmRefresh     = 120;
  51.   cmNewColor    = 121;
  52.  
  53.   cmSavePalette = 130;
  54.   cmOpenPalette = 131;
  55.   cmShowDialog  = 132;
  56.  
  57. type
  58.  
  59.   PPalApp = ^TPalApp;
  60.   TPalApp = object(TApplication)
  61.     function GetPalette: PPalette; virtual;
  62.     procedure InitStatusLine; virtual;
  63.     procedure HandleEvent(var Event: TEvent); virtual;
  64.   end;
  65.  
  66.   PWorkWindow = ^TWorkWindow;
  67.   TWorkWindow = object(TDialog)
  68.     ListBox: PListBox;
  69.     ForSel: PColorSelector;
  70.     BackSel: PColorSelector;
  71.     function GetPalette: PPalette; virtual;
  72.     procedure HandleEvent(var Event: TEvent); virtual;
  73.   end;
  74.  
  75.   ColorWindowType = (wcBlue, wcCyan, wcGray);
  76.  
  77.   PColorWindow = ^TColorWindow;
  78.   TColorWindow = object(TWindow)
  79.     ThePalette: PPalette;
  80.     constructor Init(var Bounds: TRect; ATitle: TTitleStr;
  81.       APalette: PPalette);
  82.     function GetPalette: PPalette; virtual;
  83.   end;
  84.  
  85.   PWorkDesktop = ^TWorkDesktop;
  86.   TWorkDesktop = object(TDesktop)
  87.     procedure HandleEvent(var Event: TEvent); virtual;
  88.   end;
  89.  
  90.   PWorkGroup = ^TWorkGroup;
  91.   TWorkGroup = object(TGroup)
  92.     DT: PWorkDeskTop;
  93.     MB: PMenuBar;
  94.     SL: PStatusLine;
  95.     function GetPalette: PPalette; virtual;
  96.     procedure HandleEvent(var Event: TEvent); virtual;
  97.   end;
  98.  
  99.   PTextCollection = ^TTextCollection;
  100.   TTextCollection = object(TCollection)
  101.     procedure FreeItem(Item: Pointer); virtual;
  102.   end;
  103.  
  104.   PPaletteList = ^TPaletteList;
  105.   TPaletteList = object(TListBox)
  106.     procedure FocusItem(Item: Integer); virtual;
  107.   end;
  108.  
  109.   PWinInterior = ^TWinInterior;
  110.   TWinInterior = object(TScroller)
  111.     Lines: PCollection;
  112.     procedure Draw; virtual;
  113.     destructor Done; virtual;
  114.   end;
  115.  
  116. const
  117.   CurrentPalette : FNameStr = '';
  118.   isDirty: Boolean = False;
  119.  
  120.   WindowPalettes: array[ColorWindowType] of TPalette =
  121.     (CBlueWindow, CCyanWindow, CGrayWindow);
  122.  
  123.  
  124. { TColorWindow }
  125. constructor TColorWindow.Init(var Bounds: TRect; ATitle: TTitleStr;
  126.   APalette: PPalette);
  127. begin
  128.   inherited Init(Bounds, ATitle, wnNoNumber);
  129.   ThePalette := APalette;
  130. end;
  131.  
  132. function TColorWindow.GetPalette: PPalette;
  133. begin
  134.   GetPalette := ThePalette;
  135. end;
  136.  
  137.  
  138. { TWinInterior }
  139. procedure TWinInterior.Draw;
  140. var
  141.   B: TDrawBuffer;
  142.   C: Byte;
  143.   I: Integer;
  144.   S: String;
  145.   P: PString;
  146. begin
  147.   for I := 0 to Size.Y - 1 do
  148.   begin
  149.     if (Delta.Y + I) = 1 then C := GetColor(2)
  150.     else C := GetColor(1);
  151.     MoveChar(B, ' ', C, Size.X);
  152.     if Delta.Y + I < Lines^.Count then
  153.     begin
  154.       P := Lines^.At(Delta.Y + I);
  155.       if P <> nil then S := Copy(P^, Delta.X + 1, Size.X)
  156.       else S := '';
  157.       MoveStr(B, S, C);
  158.     end;
  159.     WriteLine(0, I, Size.X, 1, B);
  160.   end;
  161. end;
  162.  
  163. destructor TWinInterior.Done;
  164. begin
  165.   if Lines <> nil then Dispose(Lines, Done);
  166.   inherited Done;
  167. end;
  168.  
  169. procedure SavePalette;
  170. var
  171.   S: TBufStream;
  172.   Desc: String;
  173.   D: PFileDialog;
  174.   C: Word;
  175. begin
  176.   if CurrentPalette = '' then
  177.   begin
  178.     D := New(PFileDialog, Init('*.PAL', 'Save As', CurrentPalette,
  179.            fdOKButton, 100));
  180.     if Desktop^.ExecView(D) <> cmCancel then
  181.       D^.GetFileName(CurrentPalette);
  182.     Dispose(D, Done);
  183.   end;
  184.   if CurrentPalette = '' then Exit;
  185.  
  186.   S.Init(CurrentPalette, stCreate, 1024);
  187.   if S.Status <> stOK then Exit;
  188.   S.Write(AppPal[64], 64);
  189.   S.Done;
  190. end;
  191.  
  192. procedure OpenPalette;
  193. var
  194.   S: TBufStream;
  195.   Desc: String;
  196.   D: PFileDialog;
  197.   C: Word;
  198. begin
  199.   D := New(PFileDialog, Init('*.PAL', 'Open Palette', '~N~ame',
  200.     fdOKButton, 100));
  201.   if Desktop^.ExecView(D) <> cmCancel then
  202.     D^.GetFileName(CurrentPalette);
  203.   Dispose(D, Done);
  204.   if CurrentPalette = '' then Exit;
  205.  
  206.   S.Init(CurrentPalette, stOpenRead, 1024);
  207.   if S.Status <> stOK then Exit;
  208.   S.Read(AppPal[64], 64);
  209.   S.Done;
  210.   Message(Desktop, evBroadcast, cmRefresh, nil);
  211. end;
  212.  
  213. procedure NoBuf(var Options: Word);
  214. begin
  215.   Options := Options and (not ofBuffered);
  216. end;
  217.  
  218. function NewTextCollection: PTextCollection;
  219. var
  220.   C: PTextCollection;
  221. begin
  222.   C := New(PTextCollection, Init(10,0));
  223.   with C^ do
  224.   begin
  225.     Insert(NewStr('This is line 1 of 10'));
  226.     Insert(NewStr('This line is selected'));
  227.     Insert(NewStr('This line is normal'));
  228.     Insert(NewStr('This is line 4 of 10'));
  229.     Insert(NewStr('This is line 5 of 10'));
  230.     Insert(NewStr('This is line 6 of 10'));
  231.     Insert(NewStr('This is line 7 of 10'));
  232.     Insert(NewStr('This is line 8 of 10'));
  233.     Insert(NewStr('This is line 9 of 10'));
  234.     Insert(NewStr('This is line 10 of 10'));
  235.   end;
  236.   NewTextCollection := C;
  237. end;
  238.  
  239. function NewWinInterior(var R: TRect; SB: PScrollBar): PWinInterior;
  240. var
  241.   Interior: PWinInterior;
  242. begin
  243.   Interior := New(PWinInterior, Init(R, nil, SB));
  244.   Interior^.Lines := NewTextCollection;
  245.   Interior^.SetLimit(0,10);
  246.   Interior^.GrowMode := gfGrowHiX + gfGrowHiY;
  247.   NewWinInterior := Interior;
  248. end;
  249.  
  250. function NewWindow(wType: ColorWindowType; ATitle: TTitleStr): PWindow;
  251. var
  252.   W: PWindow;
  253.   R: TRect;
  254.   SB: PScrollBar;
  255. begin
  256.   R.Assign(0,0,23,7);
  257.   W := New(PColorWindow, Init(R, ATitle, @WindowPalettes[wType]));
  258.   with W^ do
  259.   begin
  260.     NoBuf(Options);
  261.     SB := StandardScrollBar(sbVertical);
  262.     Insert(SB);
  263.     GetExtent(R);
  264.     R.Grow(-1,-1);
  265.     Insert(NewWinInterior(R,SB));
  266.   end;
  267.   NewWindow := W;
  268. end;
  269.  
  270.  
  271. function NewClusterDialog: PDialog;
  272. var
  273.   D: PDialog;
  274.   R: TRect;
  275.   P: PView;
  276. begin
  277.   R.Assign(0,0,30,14);
  278.   D := New(PDialog, Init(R, 'Clusters'));
  279.   with D^ do
  280.   begin
  281.     Options := Options or ofCentered;
  282.     NoBuf(Options);
  283.     R.Assign(2,2,15,5);
  284.     P := New(PCheckBoxes, Init(R, NewSItem('Check ~1~',
  285.                                   NewSItem('Check ~2~',
  286.                                   NewSItem('Check ~3~',
  287.                                   nil)))));
  288.     Insert(P);
  289.     R.Assign(1,1,15,2);
  290.     Insert(New(PLabel, Init(R, '~C~heck Boxes', P)));
  291.  
  292.     R.Assign(2,7,15,10);
  293.     P := New(PRadioButtons, Init(R, NewSItem('Radio ~X~',
  294.                                     NewSItem('Radio ~Y~',
  295.                                     NewSItem('Radio ~Z~',
  296.                                     nil)))));
  297.     Insert(P);
  298.     R.Assign(1,6,15,7);
  299.     Insert(New(PLabel, Init(R, '~R~adio Buttons', P)));
  300.  
  301.     R.Assign(16,2,28,4);
  302.     Insert(New(PButton, Init(R, '~D~efault', cmNothing, bfDefault)));
  303.     R.Move(0,2);
  304.     Insert(New(PButton, Init(R, '~N~ormal', cmNothing, bfNormal)));
  305.     R.Move(0,2);
  306.     Insert(New(PButton, Init(R, 'D~i~sabled', cmInactive, bfNormal)));
  307.  
  308.     R.Assign(2,11,28,12);
  309.     Insert(New(PStaticText, Init(R, 'This is static text')));
  310.   end;
  311.   NewClusterDialog := D;
  312. end;
  313.  
  314. function NewInputDialog: PDialog;
  315. var
  316.   D: PDialog;
  317.   R: TRect;
  318.   P: PView;
  319.   H: PHistory;
  320. begin
  321.   R.Assign(0,0,39,8);
  322.   D := New(PDialog, Init(R, 'InputLine'));
  323.   with D^ do
  324.   begin
  325.     NoBuf(Options);
  326.     R.Assign(2,3,25,4);
  327.     P := New(PInputLine, Init(R, 80));
  328.     Insert(P);
  329.     R.Assign(1,2,28,3);
  330.     Insert(New(PLabel, Init(R, '~I~nput Line', P)));
  331.     R.Assign(25,3,28,4);
  332.     H := New(PHistory, Init(R, PInputLine(P), 100));
  333.     NoBuf(H^.Options);
  334.     Insert(H);
  335.     R.Assign(1,5,11,7);
  336.     Insert(New(PButton, Init(R, '~D~efault', cmNothing, bfDefault)));
  337.     R.Move(11,0);
  338.     Insert(New(PButton, Init(R, '~N~ormal', cmNothing, bfNormal)));
  339.     R.Move(11,0);
  340.     Insert(New(PButton, Init(R, 'D~i~sabled', cmInactive, bfNormal)));
  341.     SelectNext(False);
  342.   end;
  343.   NewInputDialog := D;
  344. end;
  345.  
  346. function NewListBoxList: PTextCollection;
  347. var
  348.   C: PTextCollection;
  349. begin
  350.   C := New(PTextCollection, Init(10,0));
  351.   with C^ do
  352.   begin
  353.     Insert(NewStr('Apple'));
  354.     Insert(NewStr('Orange'));
  355.     Insert(NewStr('Banana'));
  356.     Insert(NewStr('Grape'));
  357.     Insert(NewStr('Peach'));
  358.     Insert(NewStr('Mango'));
  359.     Insert(NewStr('Lemon'));
  360.     Insert(NewStr('Lime'));
  361.     Insert(NewStr('Raisin'));
  362.   end;
  363.   NewListBoxList := C;
  364. end;
  365.  
  366. function NewListBoxDialog: PDialog;
  367. var
  368.   D: PDialog;
  369.   R: TRect;
  370.   P: PView;
  371.   SB: PScrollBar;
  372.   C: PTextCollection;
  373. begin
  374.   R.Assign(0,0,30,15);
  375.   D := New(PDialog, Init(R, 'ListBox'));
  376.   with D^ do
  377.   begin
  378.     NoBuf(Options);
  379.     R.Assign(27,2,28,8);
  380.     SB := New(PScrollBar, Init(R));
  381.     Insert(SB);
  382.     R.Assign(2,2,27,8);
  383.     P := New(PListBox, Init(R, 2, SB));
  384.     PListBox(P)^.NewList(NewListBoxList);
  385.     Insert(P);
  386.     R.Assign(1,1,15,2);
  387.     Insert(New(PLabel, Init(R, '~L~ist Box', P)));
  388.     R.Assign(2,9,14,11);
  389.     Insert(New(PButton, Init(R, '~D~efault', cmNothing, bfDefault)));
  390.   end;
  391.   NewListBoxDialog := D;
  392. end;
  393.  
  394. procedure TWorkDesktop.HandleEvent(var Event: TEvent);
  395. var
  396.   D: PFileDialog;
  397. begin
  398.   inherited HandleEvent(Event);
  399.   if Event.What = evCommand then
  400.   begin
  401.     case Event.Command of
  402.       cmCWindow: Insert(NewWindow(wcCyan, 'Cyan Window'));
  403.       cmBWindow: Insert(NewWindow(wcBlue, 'Blue Window'));
  404.       cmGWindow: Insert(NewWindow(wcGray, 'Gray Window'));
  405.       cmDClusters: Insert(NewClusterDialog);
  406.       cmDInputs: Insert(NewInputDialog);
  407.       cmDListBox: Insert(NewListBoxDialog);
  408.       else Exit;
  409.     end;
  410.     ClearEvent(Event);
  411.   end;
  412. end;
  413.  
  414. procedure TTextCollection.FreeItem(Item: pointer);
  415. begin
  416.   if Item <> nil then DisposeStr(Item);
  417. end;
  418.  
  419. function TPalApp.GetPalette: PPalette;
  420. begin
  421.   GetPalette := @AppPal;
  422. end;
  423.  
  424. function TWorkWindow.GetPalette: PPalette;
  425. begin
  426.   GetPalette := @WinPal;
  427. end;
  428.  
  429. function TWorkGroup.GetPalette: PPalette;
  430. begin
  431.   GetPalette := @GrpPal;
  432. end;
  433.  
  434. procedure TWorkGroup.HandleEvent(var Event: TEvent);
  435. begin
  436.   inherited HandleEvent(Event);
  437.   if (Event.What = evBroadcast) and (Event.Command = cmRefresh) then
  438.   begin
  439.     DT^.ReDraw;
  440.     MB^.DrawView;
  441.     SL^.DrawView;
  442.   end;
  443. end;
  444.  
  445.  
  446. function PaletteNames: PTextCollection;
  447. var
  448.   C: PTextCollection;
  449. begin
  450.   C := New(PTextCollection, Init(64,0));
  451.   with C^ do
  452.   begin
  453.     Insert(NewStr('Background'));
  454.     Insert(NewStr('Normal text'));
  455.     Insert(NewStr('Disabled text'));
  456.     Insert(NewStr('Shortcut text'));
  457.     Insert(NewStr('Normal selection'));
  458.     Insert(NewStr('Disabled selection'));
  459.     Insert(NewStr('Shortcut selection'));
  460.  
  461.     Insert(NewStr('Frame Passive (Blue)'));
  462.     Insert(NewStr('Frame Active (Blue)'));
  463.     Insert(NewStr('Frame Icon (Blue)'));
  464.     Insert(NewStr('Scrollbar Page (Blue)'));
  465.     Insert(NewStr('Scrollbar Reserved (Blue)'));
  466.     Insert(NewStr('Scroller Normal Text (Blue)'));
  467.     Insert(NewStr('Scroller Selected Text (Blue)'));
  468.     Insert(NewStr('Reserved (Blue)'));
  469.  
  470.     Insert(NewStr('Frame Passive (Cyan)'));
  471.     Insert(NewStr('Frame Active (Cyan)'));
  472.     Insert(NewStr('Frame Icon (Cyan)'));
  473.     Insert(NewStr('Scrollbar Page (Cyan)'));
  474.     Insert(NewStr('Scrollbar Reserved (Cyan)'));
  475.     Insert(NewStr('Scroller Normal Text (Cyan)'));
  476.     Insert(NewStr('Scroller Selected Text (Cyan)'));
  477.     Insert(NewStr('Reserved (Cyan)'));
  478.  
  479.     Insert(NewStr('Frame Passive (Gray)'));
  480.     Insert(NewStr('Frame Active (Gray)'));
  481.     Insert(NewStr('Frame Icon (Gray)'));
  482.     Insert(NewStr('Scrollbar Page (Gray)'));
  483.     Insert(NewStr('Scrollbar Reserved (Gray)'));
  484.     Insert(NewStr('Scroller Normal Text (Gray)'));
  485.     Insert(NewStr('Scroller Selected Text (Gray)'));
  486.     Insert(NewStr('Reserved (Gray)'));
  487.  
  488.     Insert(NewStr('Frame Passive (Dlg)'));
  489.     Insert(NewStr('Frame Active (Dlg)'));
  490.     Insert(NewStr('Frame Icon (Dlg)'));
  491.     Insert(NewStr('Scrollbar Page (Dlg)'));
  492.     Insert(NewStr('Scrollbar Controls (Dlg)'));
  493.     Insert(NewStr('Static Text'));
  494.     Insert(NewStr('Label Normal'));
  495.     Insert(NewStr('Label Highlight'));
  496.     Insert(NewStr('Label Shortcut'));
  497.  
  498.     Insert(NewStr('Button Normal'));
  499.     Insert(NewStr('Button Default'));
  500.     Insert(NewStr('Button Selected'));
  501.     Insert(NewStr('Button Disabled'));
  502.     Insert(NewStr('Button Shortcut'));
  503.     Insert(NewStr('Button Shadow'));
  504.     Insert(NewStr('Cluster Normal'));
  505.     Insert(NewStr('Cluster Selected'));
  506.     Insert(NewStr('Cluster Shortcut'));
  507.  
  508.     Insert(NewStr('Inputline Normal'));
  509.     Insert(NewStr('Inputline Selected'));
  510.     Insert(NewStr('Inputline Arrows'));
  511.     Insert(NewStr('History Arrow'));
  512.     Insert(NewStr('History Sides'));
  513.     Insert(NewStr('Scrollbar page (Hist)'));
  514.     Insert(NewStr('Scrollbar controls (Hist)'));
  515.  
  516.     Insert(NewStr('Listviewer Normal'));
  517.     Insert(NewStr('Listviewer Focused'));
  518.     Insert(NewStr('Listviewer Selected'));
  519.     Insert(NewStr('Listviewer Divider'));
  520.     Insert(NewStr('InfoPane'));
  521.     Insert(NewStr('Reserved'));
  522.     Insert(NewStr('Reserved'));
  523.  
  524.   end;
  525.   PaletteNames := C;
  526. end;
  527.  
  528. procedure TPaletteList.FocusItem(Item: Integer);
  529. var
  530.   B: Byte;
  531. begin
  532.   inherited FocusItem(Item);
  533.   B := Byte( AppPal[64 + Item] );
  534.   Message(Owner, evBroadcast, cmNewColor, Pointer(B));
  535.   Message(Owner, evBroadcast, cmColorSet, Pointer(B));
  536. end;
  537.  
  538.  
  539. procedure TWorkWindow.HandleEvent(var Event: TEvent);
  540. var
  541.   B, B2: Byte;
  542. begin
  543.   inherited HandleEvent(Event);
  544.  
  545.   if Event.What = evBroadcast then
  546.   begin
  547.     case Event.Command of
  548.       cmColorBackgroundChanged:
  549.         begin
  550.           B := Byte( AppPal[ListBox^.Focused + 64] );
  551.           B := (B and $0F) or (Event.InfoByte shl 4 and $F0);
  552.         end;
  553.       cmColorForegroundChanged:
  554.         begin
  555.           B := Byte( AppPal[ListBox^.Focused + 64] );
  556.           B := (B and $F0) or (Event.InfoByte and $0F);
  557.         end;
  558.       else Exit;
  559.     end;
  560.     AppPal[ListBox^.Focused + 64] := Char(B);
  561.     Message(Desktop, evBroadcast, cmRefresh, Pointer(B));
  562.     Message(@Self, evBroadcast, cmNewColor, Pointer(B));
  563.     ClearEvent(Event);
  564.   end;
  565. end;
  566.  
  567.  
  568. procedure ShowDialog;
  569. var
  570.   R: TRect;
  571.   W: PWorkWindow;
  572.   G: PWorkGroup;
  573.   P: PView;
  574.   SB: PScrollBar;
  575. begin
  576.   Desktop^.GetExtent(R);
  577.   R.A.X := R.B.X - 75;
  578.   Dec(R.B.Y,2);
  579.   W := New(PWorkWindow, Init(R, 'Color Selection'));
  580.   with W^ do
  581.   begin
  582.     Options := Options or ofCentered;
  583.     EventMask := EventMask or evBroadcast;
  584.  
  585.     R.Assign(35,2,36,12);
  586.     SB := New(PScrollBar, Init(R));
  587.     Insert(SB);
  588.     R.Assign(1,2,35,12);
  589.     ListBox := New(PPaletteList, Init(R, 1, SB));
  590.     Insert(ListBox);
  591.     ListBox^.NewList(PaletteNames);
  592.     Dec(R.A.Y); R.B.Y := R.A.Y+1;
  593.     Insert(New(PLabel, Init(R, '~I~tems', ListBox)));
  594.  
  595.     R.Assign(3, 13, 15, 17);
  596.     ForSel := New(PColorSelector, Init(R, csForeground));
  597.     Insert(ForSel);
  598.     Dec(R.A.Y); R.B.Y := R.A.Y+1;
  599.     Insert(New(PLabel, Init(R, '~F~oreground', ForSel)));
  600.  
  601.     R.Assign(18, 13, 30, 15);
  602.     BackSel := New(PColorSelector, Init(R, csBackground));
  603.     Insert(BackSel);
  604.     Dec(R.A.Y); R.B.Y := R.A.Y+1;
  605.     Insert(New(PLabel, Init(R, '~B~ackground', BackSel)));
  606.  
  607.     R.Assign(1,18,13,20);
  608.     Insert(New(PButton, Init(R, '~O~K', cmOK, bfNormal)));
  609.  
  610.     GetExtent(R);
  611.     R.Grow(-1,-1);
  612.     R.A.X := R.B.X - 36;
  613.     G := New(PWorkGroup, Init(R));
  614.     Insert(G);
  615.  
  616.     with G^ do
  617.     begin
  618.       GrowMode := gfGrowHiX + gfGrowHiY;
  619.       Options := Options or ofFramed;
  620.       GetExtent(R); R.Grow(0,-1);
  621.       DT := New(PWorkDesktop, Init(R));
  622.       DT^.Options := DT^.Options and (not ofBuffered);
  623.       Insert(DT);
  624.  
  625.       GetExtent(R);
  626.       R.A.Y := R.B.Y - 1;
  627.       SL := New(PStatusLine, Init(R,
  628.         NewStatusDef(0, 0,
  629.           NewStatusKey('~F1~ Active', 0, cmNothing,
  630.           NewStatusKey('~F2~ Inactive', 0, cmInactive,
  631.           nil)),
  632.         nil)));
  633.       Insert(SL);
  634.  
  635.       GetExtent(R); R.B.Y := R.A.Y + 1;
  636.       MB := New(PMenuBar, Init(R, NewMenu(
  637.              NewSubMenu('Fi~l~e', 0, NewMenu(
  638.                NewItem('~A~ctive', 'F1', 0, cmNothing, 0,
  639.                NewItem('~I~nactive', 'F2', 0, cmInactive, 0,
  640.                nil))),
  641.              NewSubMenu('~V~iews', 0, NewMenu(
  642.                NewSubMenu('~W~indows...', 0, NewMenu(
  643.                  NewItem('~B~lue Window', '', 0, cmBWindow, 0,
  644.                  NewItem('~C~yan Window', '', 0, cmCWindow, 0,
  645.                  NewItem('~G~ray Window', '', 0, cmGWindow, 0,
  646.                  nil)))),
  647.                NewSubMenu('~D~ialogs', 0, NewMenu(
  648.                  NewItem('Dialog with TClusters','', 0, cmDClusters, 0,
  649.                  NewItem('Dialog with TInputLine','', 0, cmDInputs, 0,
  650.                  NewItem('Dialog with TListBox','', 0, cmDListBox, 0,
  651.                  nil)))),
  652.              nil))),
  653.            nil)))));
  654.  
  655.       Insert(MB);
  656.     end;
  657.     ListBox^.FocusItem(ListBox^.Focused);
  658.     SelectNext(False);
  659.  
  660.   end;
  661.   Desktop^.ExecView(W);
  662.   Dispose(W, Done);
  663. end;
  664.  
  665. procedure TPalApp.InitStatusLine;
  666. var R: TRect;
  667. begin
  668.   GetExtent(R);
  669.   R.A.Y := R.B.Y - 1;
  670.   StatusLine := New(PStatusLine, Init(R,
  671.     NewStatusDef(0, $FFFF,
  672.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  673.       NewStatusKey('~F2~ Save', kbF2, cmSavePalette,
  674.       NewStatusKey('~F3~ Open', kbF3, cmOpenPalette,
  675.       NewStatusKey('~F9~ Edit', kbF9, cmShowDialog,
  676.       NewStatusKey('', kbF6, cmNext,
  677.       nil))))),
  678.     nil)
  679.   ));
  680. end;
  681.  
  682. procedure TPalApp.HandleEvent(var Event: TEvent);
  683. begin
  684.   inherited HandleEvent(Event);
  685.   if (Event.What = evCommand) and (Event.Command = cmSavePalette) then
  686.     SavePalette;
  687.   if (Event.What = evCommand) and (Event.Command = cmOpenPalette) then
  688.     OpenPalette;
  689.   if (Event.What = evCommand) and (Event.Command = cmShowDialog) then
  690.     ShowDialog;
  691. end;
  692.  
  693.  
  694. var
  695.   A: TPalApp;
  696.  
  697. begin
  698.   A.Init;
  699.   A.DisableCommands([cmInactive]);
  700.   A.Run;
  701.   A.Done;
  702. end.
  703.